Business Assistant/Business Assistant.iso/indus/rental/addb.prg

Text File | 1986-05-30 | 21KB | 717 lines

**    Last revision: May 27, 1986 at 19:09
* addb.prg
STOR 'A' TO choice
CLEA
TEXT

    Welcome to the 'ADD' Menu.  We can now add new buildings to the
    data file - or add new tenants to existing buildings already in
    the data base.

    Note that when you add a building, you will be given the option
    of adding the tenants or the units at the same time.

          <A> add a new building
          <B> add tenants to a building already in the data base
          <C> return to main menu without adding











ENDT
@ 13,10 SAY 'How shall we proceed ? '
@ 13,42 GET choice picture '!'
READ
DO WHIL AT(choice, 'ABC') = 0
 @ 13,42 GET choice PICTURE '!'
 READ
 CLEA GETS
ENDD while AT(choice)
DO CASE
CASE choice = 'A'
* this program will add records to the current files
 STOR .t. TO first
 STOR .t. TO more
 SET INTENSITY ON
 SET DELIMITER OFF
 DO WHIL more
* set up screen for data entry
  IF first
   DO b_first
   STOR .f. TO first
  ENDI
  STOR 'Add Building Records' TO mode
  STOR 'First enter data about the building. You then will be able to' TO prompt1
  STOR 'enter tenant data before you enter another building.' TO prompt2
  STOR "To terminate session leave building blank and hit control 'Q'or 'W'" TO prompt3
* get a set of default memory variables for data entry
  STOR SPACE(50) TO blnks
  STOR SUBSTR(blnks,1,35) TO mbaddr
  STOR SUBSTR(blnks,1,2) TO mbcode
  STOR SUBSTR(blnks,1,20) TO mbcity
  STOR SUBSTR(blnks,1,2) TO mbst
  STOR SUBSTR(blnks,1,5) TO mbzip
  STOR SUBSTR(blnks,1,25) TO mbmgr
  STOR SUBSTR(blnks,1,13) TO mbphone
  STOR SUBSTR(blnks,1,2) TO mbtype
  STOR SUBSTR(blnks,1,3) TO mbunit
  STOR SUBSTR(blnks,1,8) TO mbacq
  STOR 0 TO mbprice
  STOR SUBSTR(blnks,1,35) TO mremit
  STOR SUBSTR(blnks,1,13) TO mphone
  STOR SUBSTR(blnks,1,35) TO mremitad
  STOR SUBSTR(blnks,1,35) TO mremitc
  STOR SUBSTR(blnks,1,50) TO mchecks
  STOR SUBSTR(blnks,1,50) TO mbnotes
  STOR DTOC(date()) TO mbupdate
* let user enter data
  @ 1,26 SAY mode
  @ 3,10 GET mbaddr
  @ 3,61 GET mbcode PICTURE '99'
  @ 4,10 GET mbcity
  @ 4,44 GET mbst PICTURE '!!'
  @ 4,61 GET mbzip PICTURE '99999'
  @ 6,10 GET mbmgr
  @ 6,61 GET mbphone PICTURE '[phone]'
  @ 7,10 GET mbtype
  @ 7,61 GET mbunit
  @ 9,10 GET mbacq PICTURE '99/99/99'
  @ 9,61 GET mbprice
  @ 12,10 GET mremit
  @ 12,61 GET mphone PICTURE '[phone]'
  @ 13,10 GET mremitad
  @ 14,10 GET mremitc
  @ 15,10 GET mchecks
  @ 17,10 GET mbnotes
  @ 18,61 GET mbupdate PICTURE '99/99/99'
  @ 20, 4 SAY prompt1
  @ 21, 4 SAY prompt2
  @ 22, 4 SAY prompt3
  READ
  CLEA GETS
* if a building was entered
* add a new record with the entered data
  IF mbaddr <> ' '
* validation
* this module validates added records
* test if there is a bad field validation
   DO CASE
   CASE mbcode = ' '
* no building code
    STOR .t. TO error
   OTHE
    STOR .f. TO error
   ENDC
* if test for error was true then fix the fields that need fixing
   IF error
* erase the lines to be used for prompts
    @ 01,00
    @ 20,00
    @ 21,00
    @ 22,00
* tell them to correct it
    @ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
    STOR .t. to an_error
    DO WHIL an_error
     DO CASE
     CASE mbcode = ' '
      @ 20,15 SAY 'Must have a building code                              '
      @ 03,61 GET mbcode PICTURE '99'
      READ
     OTHE
      STOR .f. TO an_error
     ENDC
    ENDD while an:error
   ENDI error
   RELE error, an_error
   SET DELIMITER ON
   SET INTENSITY OFF
   STOR 'N' TO command
   @ 20,01 SAY SPACE(75)
   @ 21,01 SAY SPACE(75)
   @ 22,01 SAY SPACE(75)
   @ 20,15 SAY 'Are there any more changes ?                        '
   @ 20,48 GET command picture '!'
   READ
   SET DELIMITER OFF
   SET INTENSITY ON
   IF command = 'Y'
    @ 1,00
    @ 1,26 SAY mode
    @ 3,10 GET mbaddr
    @ 3,61 GET mbcode PICTURE '99'
    @ 4,10 GET mbcity
    @ 4,44 GET mbst PICTURE '!!'
    @ 4,61 GET mbzip PICTURE '99999'
    @ 6,10 GET mbmgr
    @ 6,61 GET mbphone PICTURE '[phone]'
    @ 7,10 GET mbtype
    @ 7,61 GET mbunit
    @ 9,10 GET mbacq PICTURE '99/99/99'
    @ 9,61 GET mbprice
    @ 12,10 GET mremit
    @ 12,61 GET mphone PICTURE '[phone]'
    @ 13,10 GET mremitad
    @ 14,10 GET mremitc
    @ 15,10 GET mchecks
    @ 17,10 GET mbnotes
    @ 18,61 GET mbupdate PICTURE '99/99/99'
    @ 20,01 SAY SPACE(75)
    @ 21,01 SAY SPACE(75)
    @ 22,01 SAY SPACE(75)
    @ 20,04 SAY prompt1
    @ 21,04 SAY prompt2
    @ 22,04 SAY prompt3
    READ
    CLEA GETS
   ENDI command = 'Y'
* add new record
   APPE BLANK
   REPL baddr WITH mbaddr, bcode WITH mbcode
   REPL bcity WITH mbcity+mbst+mbzip
   REPL bdata WITH mbmgr+mbphone+mbtype+mbunit+mbacq
   REPL bprice WITH mbprice, remit WITH mremit, phone WITH mphone
   REPL remitad WITH mremitad, remitc WITH mremitc
   REPL checks WITH mchecks, bnotes with mbnotes, bupdate WITH mbupdate
   RELE mbcity, mbst, mbzip, mbmgr, mbphone, mbtype, mbunit, mbacq
   RELE mbprice, mremit, mphone, mremitad, mremitc
   RELE mchecks, mbnotes, mode, prompt1, prompt2, prompt3
   SELE B
   USE &dr.:tenant
   SET INDEX TO &dr.:codea
   STOR .t. TO more1
   STOR .t. TO first
   CLEA
   DO WHIL more1
    IF first
     DO t_first
     STOR .f. TO first
    ENDI
    STOR 'Add Tenant Records' TO mode
    STOR 'Enter as many tenants as you want. When done, enter a blank for tenant' TO prompt1
    STOR "name and unit or control 'Q' or 'W' to end session." TO prompt2
    STOR SUBSTR(blnks,1,35) TO mtenant
    STOR SUBSTR(blnks,1,3) TO mtcode
    STOR SUBSTR(blnks,1,5) to mtunit
    STOR 'R' TO mttype
    STOR SUBSTR(blnks,1,25) TO mtcontac
    STOR SUBSTR(blnks,1,13) TO mtphone
    STOR 'N' TO malt
    STOR SUBSTR(blnks,1,35) TO maltad
    STOR SUBSTR(blnks,1,35) TO maltcty
    STOR SUBSTR(blnks,1,8) TO mtexpir
    STOR SUBSTR(blnks,1,8) TO mtfirst
    STOR 0 TO mtsec
    STOR SUBSTR(blnks,1,4) TO mtsecb
    STOR SUBSTR(blnks,1,2) TO mtlate
    STOR 0 TO mtrent
    STOR 0.0000 TO mtrentpc
    STOR 0 TO mtrenpcr
    STOR 0 TO mtlatec
    STOR 0 TO mtaddl
    STOR 0 TO mtrente
    STOR 0 TO mtrentm
    STOR 0 TO mtrentd
    STOR SUBSTR(blnks,1,8) TO mtrentpd
    STOR 0 TO mtrentp
    STOR 0 TO mtrenty
    STOR 0 TO mtrentt
    STOR SUBSTR(blnks,1,8) TO mtflag
    STOR SUBSTR(blnks,1,35) TO mtnotes
    STOR mbupdate TO mtupdate
* setup gets to read data
    @ 1,26 SAY mode
    @ 3,10 GET mtenant
    @ 3,62 SAY mbcode
    @ 3,64 GET mtcode PICTURE '999'
    @ 4,10 GET mtunit
    @ 4,36 SAY mbaddr
    @ 5,10 GET mtcontac
    @ 5,62 GET mtphone PICTURE '[phone]'
    @ 6,36 GET malt PICTURE '!'
    @ 7,10 GET maltad
    @ 8,10 GET maltcty
    @ 10,10 GET mttype PICTURE '!'
    @ 10,36 GET mtrentpc
    @ 10,62 GET mtfirst PICTURE '99/99/99'
    @ 11,10 GET mtrenpcr
    @ 11,62 GET mtexpir PICTURE '99/99/99'
    @ 12,10 GET mtsec
    @ 12,36 GET mtsecb
    @ 12,62 GET mtlate PICTURE '99'
    @ 13,10 GET mtrent
    @ 13,36 GET mtlatec
    @ 13,62 GET mtaddl
    @ 14,10 GET mtrente
    @ 14,36 GET mtrentm
    @ 15,10 GET mtrentd
    @ 15,36 GET mtrentp PICTURE '99/99/99'
    @ 15,62 GET mtrentp
    @ 16,10 GET mtrenty
    @ 16,36 GET mtflag PICTURE '99/99/99'
    @ 16,62 GET mtrentt
    @ 18,10 GET mtnotes
    @ 18,61 GET mtupdate PICTURE '99/99/99'
    @ 20,01 SAY SPACE(75)
    @ 21,01 SAY SPACE(75)
    @ 22,01 SAY SPACE(75)
    @ 20, 7 SAY prompt1
    @ 21, 7 SAY prompt2
    READ
    CLEA GETS
* test if there is a bad field validation
    IF mtenant <> ' '
* validation
     DO CASE
     CASE mtcode = ' '
      STOR .t. TO error
     CASE .NOT.(malt = 'Y' .OR. malt = 'N')
      STOR .t. TO error
     CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
      STOR .t. TO error
     CASE (mttype = 'P'.OR. mttype = 'O') .AND.(.NOT.(mtr